home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _2355418b255146bee03d9849ddedf640 < prev    next >
Encoding:
Text File  |  2002-05-30  |  2.7 KB  |  109 lines
  1. package Tk::DragDrop::SunSite;
  2. require Tk::DropSite;
  3.  
  4. use vars qw($VERSION);
  5. $VERSION = '3.011'; # $Id: //depot/Tk8/DragDrop/DragDrop/SunSite.pm#11 $
  6.  
  7. use Tk::DragDrop::SunConst;
  8. use base  qw(Tk::DropSite);
  9. use strict;
  10.  
  11. Tk::DropSite->Type('Sun');
  12.  
  13. sub SunDrop
  14. {
  15.  my ($w,$site) = @_;
  16.  my $e = $w->XEvent;
  17.  my ($atom,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$e->A);
  18.  $x -= $site->X;
  19.  $y -= $site->Y;
  20.  my $seln = $w->GetAtomName($atom);
  21.  if ($flags & &ACK_FLAG)
  22.   {
  23.    eval {local $SIG{__DIE__}; $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_ACK');};
  24.   }
  25.  $site->Callback(-dropcommand => $seln, $x, $y);
  26.  if ($flags & &TRANSIENT_FLAG)
  27.   {
  28.    eval {local $SIG{__DIE__};  $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_DONE');};
  29.   }
  30.  $w->configure('-relief' => $w->{'_DND_RELIEF_'}) if (defined $w->{'_DND_RELIEF_'});
  31.  $site->Callback(-entercommand => 0, $x, $y);
  32. }
  33.  
  34. sub SunPreview
  35. {
  36.  my ($w,$site) = @_;
  37.  my $event = $w->XEvent;
  38.  my ($kind,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$event->A);
  39.  $x -= $site->X;
  40.  $y -= $site->Y;
  41.  if ($kind == _enter)
  42.   {
  43.    $site->Callback(-entercommand => 1, $x, $y);
  44.   }
  45.  elsif ($kind == _leave)
  46.   {
  47.    $site->Callback(-entercommand => 0, $x, $y);
  48.   }
  49.  elsif ($kind == _motion)
  50.   {
  51.    $site->Callback(-motioncommand => $x, $y);
  52.   }
  53. }
  54.  
  55. sub InitSite
  56. {
  57.  my ($class,$site) = @_;
  58.  my $w = $site->widget;
  59.  $w->BindClientMessage('_SUN_DRAGDROP_TRIGGER',[\&SunDrop,$site]);
  60.  $w->BindClientMessage('_SUN_DRAGDROP_PREVIEW',[\&SunPreview,$site]);
  61. }
  62.  
  63. sub NoteSites
  64. {
  65.  my ($class,$t,$sites) = @_;
  66.  my $count = @$sites;
  67.  my @data  = (0,0);
  68.  my ($wrapper,$offset) = $t->wrapper;
  69.  if ($t->viewable)
  70.   {
  71.    my $s;
  72.    my $i = 0;
  73.    my @win;
  74.    my $bx = $t->rootx;
  75.    my $by = $t->rooty - $offset;
  76.    $t->MakeWindowExist;
  77.    foreach $s (@$sites)
  78.     {
  79.      my $w = $s->widget;
  80.      if ($w->viewable)
  81.       {
  82.        $w->MakeWindowExist;
  83.        $data[1]++;
  84.        push(@data,${$w->WindowId});                   # XID
  85.        push(@data,$i++);                              # Our 'tag'
  86.        push(@data,ENTERLEAVE|MOTION);                 # Flags
  87.        push(@data,0);                                 # Kind is 'rect'
  88.        push(@data,1);                                 # Number of rects
  89.        push(@data,$s->X-$bx,$s->Y-$by,$s->width,$s->height);  # The rect
  90.       }
  91.     }
  92.   }
  93.  if ($data[1])
  94.   {
  95.    $t->property('set',
  96.                 '_SUN_DRAGDROP_INTEREST',           # name
  97.                 '_SUN_DRAGDROP_INTEREST',           # type
  98.                 32,                                 # format
  99.                 \@data,$wrapper);                   # the data
  100.   }
  101.  else
  102.   {
  103.    $t->property('delete','_SUN_DRAGDROP_INTEREST',$wrapper);
  104.   }
  105. }
  106.  
  107.  
  108. 1;
  109.